home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PCTV3N3 / CLOCKISR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-29  |  4KB  |  147 lines
  1. unit ClockISR;
  2. interface
  3.  
  4. uses CRT,DOS;
  5.  
  6. type  str2 = string[2];
  7.  
  8. procedure MoveClock(row,col:byte); 
  9. procedure RestoreClock; 
  10. procedure SuspendClock; 
  11. procedure ResumeClock;  
  12.  
  13. implementation
  14.  
  15. const  ClockRow : byte = 25;        
  16.        ClockCol : byte = 74;  
  17.  
  18. var  ClkStr           : string[6];      
  19.      coord,  curs,      
  20.      Hour, Minute,      
  21.      Counter          : word;      
  22.      ExitSave, Old1C  : pointer;      
  23.      V                : text;  { for DirectVideo writes }
  24.  
  25. function Fmt(i : integer):str2; 
  26. var t : str2; 
  27. begin   
  28.   Str(i:2,t);   
  29.   if t[1]=' ' then     
  30.     t[1] := '0';   
  31.   Fmt := t; 
  32. end;  
  33.  
  34. procedure SaveCursor; 
  35. var reg : DOS.Registers; 
  36. begin   
  37.   reg.AH := 3;   
  38.   reg.BH := 0;   
  39.   intr($10,reg);   
  40.   coord  := reg.DX;   { Cursor position }   
  41.   curs   := reg.CX;   { Top and bottom lines }   
  42.   reg.AH := 1;   
  43.   reg.CH := $20;      { Hides cursor on MDA, CGA, VGA }
  44.   intr($10,reg);      { Change CH for Herc and EGA    } 
  45. end;  
  46.  
  47. procedure RestoreCursor; 
  48. var reg : DOS.Registers; 
  49. begin   
  50.   reg.AH := 2;   
  51.   reg.BH := 0;   
  52.   reg.DX := coord;  { Put cursor back in place }   
  53.   intr($10,reg);   
  54.   reg.CX := curs;   { Restore cursor lines }   
  55.   reg.AH := 1;   
  56.   intr($10,reg); 
  57. end;  
  58.  
  59. procedure MoveClock; 
  60. begin   
  61.   ClockRow := row;   
  62.   ClockCol := col; 
  63. end;  
  64.  
  65. procedure RestoreClock; 
  66. begin   
  67.   ClockRow := 25;   
  68.   ClockCol := 74; 
  69. end;  
  70.  
  71. procedure JumpToPriorISR(p: pointer);
  72. inline($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/$EC/$5D/$07/$1F/
  73.        $5F/$5E/$5A/$59/$CB); 
  74.  
  75. procedure Clock;interrupt; 
  76. var a : byte; 
  77. begin   
  78.   dec(Counter);   
  79.   if Counter=0 then     
  80.     begin       
  81.       inc(Minute);       
  82.       if Minute>59 then         
  83.         begin           
  84.           inc(Hour);           
  85.           if Hour>23 then             
  86.             Hour := 0;           
  87.           Minute := 0;         
  88.         end;       
  89.       if Hour=0 then         
  90.         ClkStr := '12'       
  91.       else         
  92.         if Hour>12 then           
  93.           ClkStr := Fmt(Hour-12)         
  94.         else           
  95.           ClkStr := Fmt(Hour);       
  96.       ClkStr := ClkStr+':'+Fmt(Minute)+' ';       
  97.       if Hour<12 then         
  98.         ClkStr[6] := 'A'       
  99.       else         
  100.         ClkStr[6] := 'P';       
  101.       Counter := 1091;     
  102.     end;   
  103.   if odd(Counter) then     
  104.     begin       
  105.       SaveCursor;       
  106.       GotoXY(ClockCol,ClockRow);       
  107.       a := TextAttr;     { Store current CRT color combo }
  108.       TextAttr := 15;       
  109.       Write(V,ClkStr);       
  110.       TextAttr := a;     { Restore color combo }
  111.       RestoreCursor;     
  112.     end;   
  113.   JumpToPriorISR(Old1C); 
  114. end;  
  115.  
  116. procedure ClockExit; far;  { For TP4 and 5 use $F+/$F- } 
  117. begin { Restore clock interrupt vector }   
  118.   SetIntVec($1C,Old1C);   
  119.   TextAttr := 7;             { tidy up the screen }
  120.   GotoXY(ClockCol,ClockRow);   
  121.   write('      ');  { Six spaces }   
  122.   ExitProc := ExitSave; 
  123. end;
  124.  
  125. procedure SuspendClock;  { Restore the original vector, } 
  126. begin                    { suspending our clock         }    
  127. SetIntVec($1C,Old1C); 
  128. end;
  129.  
  130. procedure ResumeClock; 
  131. begin   
  132.   GetTime(Hour,Minute,Counter,Counter); { Back in business }
  133.   Counter := 1;   
  134.   SetIntVec($1C,@Clock); 
  135. end;
  136.  
  137. begin   
  138.   AssignCRT(V);   
  139.   rewrite(V);   
  140.   ExitSave := ExitProc;   
  141.   ExitProc := @ClockExit;   
  142.   GetTime(Hour,Minute,Counter,Counter);   
  143.   Counter := 1;   
  144.   GetIntVec($1C,Old1C);   { The old interrupt vector }
  145.   SetIntVec($1C,@Clock);  { What we want done instead } 
  146. end.
  147.